home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_rgb < prev    next >
Encoding:
Text File  |  1991-12-30  |  3.1 KB  |  154 lines
  1. \ Demonstrate color cycling using SetRGB4
  2. \
  3. \ Author:  Phil Burk
  4. \ Copyright 1988 Delta Research
  5.  
  6. decimal
  7. INCLUDE? NewWindow.Setup JU:AMIGA_GRAPH
  8. include? sc_Viewport ji:intuition/intuition.j
  9. INCLUDE? NewScreen.Setup JU:SCREEN_SUPPORT
  10. INCLUDE? ?CLOSEBOX JU:AMIGA_EVENTS
  11. include? msec ju:msec
  12. include? choose ju:random
  13.  
  14. ANEW TASK-DEMO_RGB
  15.  
  16. decimal
  17.  
  18. \ Declare necessary Amiga 'C' structures.
  19. NewScreen RGB-NewScreen
  20. NewWindow RGB-NewWindow
  21.  
  22. VARIABLE RGB-SCREEN
  23.  
  24. : RGB.INIT.SCREEN ( -- screen | NULL )
  25.     gr.init
  26. \ Set to default values.
  27.     RGB-NewScreen NewScreen.Setup
  28.     RGB-NewWindow NewWindow.Setup
  29. \
  30. \ Modify defaults for this demo.
  31.     4 RGB-NewScreen s! ns_Depth  ( 16 colors )
  32. \
  33. \ Open Screen and store pointer in NewWindow structure.
  34.     RGB-NewScreen openscreen() dup RGB-Screen !  ( Open screen. )
  35. \
  36. \ Sometimes the Amiga can build a bad COPPER list for screens.
  37. \ This can happen if you have Emacs and Workbench up in INTERLACE
  38. \ mode and open a NON-INTERLACE screen.
  39. \ The following calls will correct this problem (hopefully).
  40.     RGB-screen @ screentoback()
  41.     RemakeDisplay()
  42.     RGB-screen @ screentofront()
  43. ;
  44.  
  45. : RGB.INIT.WINDOW ( screen -- window | NULL )
  46.     RGB-NewWindow s! nw_screen
  47. \
  48. \ Set up window.
  49.     0" RGB - JForth - Delta Research"
  50.         RGB-NewWindow s! nw_Title
  51.     CUSTOMSCREEN   RGB-NewWindow s! nw_type
  52.     RGB-NewWindow s@ nw_Flags ACTIVATE |
  53.         RGB-NewWindow s! nw_Flags
  54.     20    RGB-NewWindow s! nw_TopEdge
  55.     320  RGB-NewWindow s! nw_Width
  56.     160  RGB-NewWindow s! nw_Height
  57.     RGB-NewWindow gr.opencurw
  58. ;
  59.  
  60. : RGB.TERM ( -- , CLose demo screen )
  61.     gr.closecurw
  62.     RGB-screen @ closescreen()
  63. ;
  64.  
  65. : SetRGB4() ( vp index r g b -- , call Amiga routine )
  66.     callvoid>abs graphics_lib SetRGB4
  67. ;
  68.  
  69. : GetRGB4() ( colormap index -- packed_RGB )
  70.     call>abs graphics_lib getrgb4
  71. ;
  72.  
  73. : UNPACK.RGB ( packed_rgb -- r g b )
  74.     dup>r
  75.     -8 shift 15 and
  76.     r@ -4 shift 15 and
  77.     r> 15 and
  78. ;
  79.  
  80. : GET.VP ( -- vp , get rel address of viewport )
  81.     RGB-SCREEN @ ( -- rel_screen )
  82.     .. sc_ViewPort ( -- rel_ViewPort )
  83. ;
  84.  
  85. : GET.CM ( -- colormap )
  86.     RGB-SCREEN @
  87.     .. sc_ViewPort
  88.     s@ vp_colormap ( relative address of colormap )
  89. ;
  90.  
  91. : GET.RGB ( index -- r g b )
  92.     get.cm swap getRGB4()
  93.     unpack.RGB
  94. ;
  95.  
  96. variable RGB-#COLORS
  97. : RGB.DRAW.STUFF ( -- , draw colored boxes )
  98.     1 rgb-NewScreen s@ ns_depth shift
  99.     dup rgb-#colors !
  100.     2
  101.     DO i gr.color!
  102.         5 i 14 * +
  103.         5
  104.         over 14 +
  105.         120
  106.         gr.rect
  107.     LOOP
  108. ;
  109.  
  110. : RAND.COLOR ( index -- , set color to random RGB )
  111.     get.vp swap 16 choose 16 choose 16 choose SetRGB4()
  112. ;
  113.  
  114. : SHUFFLE.COLORS  ( -- move colors )
  115.     rgb-#colors @  1- 2
  116.     DO  get.vp i
  117.         i 1+ get.rgb SetRGB4()
  118.     LOOP
  119.     rgb-#colors @  1- rand.color
  120. ;
  121.  
  122. : DEMO.RGB  ( -- , cycle colors with random source )
  123.     rgb.init.screen ?dup
  124.     IF  rgb.init.window
  125.         IF  rgb.draw.stuff
  126.             BEGIN
  127.                 200 msec
  128.                 shuffle.colors
  129.                 ?closebox
  130.             UNTIL
  131.             rgb.term
  132.         THEN
  133.     THEN
  134. ;
  135.  
  136. : DEMO.RGB.LINES  ( -- , simpler example )
  137.     rgb.init.screen ?dup
  138.     IF  rgb.init.window
  139.         IF  5 gr.color!
  140.             0 0 gr.move
  141.             BEGIN
  142.                 300 choose 160 choose gr.draw  ( draw line )
  143.                 14 choose 2+ rand.color
  144.                 14 choose 2+ gr.color!
  145.                 ?closebox
  146.             UNTIL
  147.             rgb.term
  148.         THEN
  149.     THEN
  150.     gr.term
  151. ;
  152.  
  153. cr ." Enter:    DEMO.RGB or DEMO.RGB.LINES" cr
  154.